En este documento se presentan tres análisis con graficos interactivos para realizar con datos de Eventos de Notificación obligatoria provenientes de Datos Abiertos.

Para las visualizaciones interactivas se utilizaron los paquetes highcharter y Leaflet.

Instalación de paquetes y lectura de datos:

library(readxl)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ISOweek)
library(tidyr)
library(highcharter)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo 
## Highcharts (www.highcharts.com) is a Highsoft software product which is
## not free for commercial and Governmental use
library(tsibble)
## 
## Attaching package: 'tsibble'
## 
## The following object is masked from 'package:lubridate':
## 
##     interval
## 
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, union
library(lubridate)
library(geojsonsf)
library(echarts4r)
library(sf)
## Linking to GEOS 3.11.2, GDAL 3.6.2, PROJ 9.2.0; sf_use_s2() is TRUE
library(tmap)
## The legacy packages maptools, rgdal, and rgeos, underpinning the sp package,
## which was just loaded, will retire in October 2023.
## Please refer to R-spatial evolution reports for details, especially
## https://r-spatial.org/r/2023/05/15/evolution4.html.
## It may be desirable to make the sf package available;
## package maintainers should consider adding sf to Suggests:.
## The sp package is now running under evolution status 2
##      (status 2 uses the sf package in place of rgdal)
library(leaflet)
library(DT)
##leo la tablas
datos_respiratorias <- 
  read_excel("RMD/RMD003_Analisis/datos/informacion-publica-respiratorias-nacional-hasta-20230706.xlsx")


##para otros años
datos_respiratorias2 <- read_excel("RMD/RMD003_Analisis/datos/informacion-publica-respiratorias-nacional-hasta-20220905.xlsx")

Serie temporal de notificaciones de ETI (Enfermedad Tipo Influenza)

datos_eti <- datos_respiratorias %>%
  filter(evento_nombre == "Enfermedad tipo influenza (ETI)") %>%
  group_by(provincia_nombre, provincia_id, año, semanas_epidemiologicas) %>%
  summarise(conteo = sum(cantidad_casos))

datos_eti2 <- datos_respiratorias2 %>%
  filter(evento_nombre == "Enfermedad tipo influenza (ETI)",
         año != 2022) %>%
  group_by(provincia_nombre, provincia_id, año, semanas_epidemiologicas) %>%
  summarise(conteo = sum(cantidad_casos))

datos_eti <- rbind(datos_eti, datos_eti2)
DT::datatable(head(datos_eti))

Transformamos las variables Año y semanas_epidemiológicas en una variable con formato fecha de la semana. Para ello creo una función (convert_epiweek) porque las semanas epi en el año 2020 tuvieron características que no me permiten hacen una transformación a fecha directa.

###esta fn sirve para generar una variable fecha a aprtir de un vector de año y otro de semana EPI.
convert_epiweek <- function(year, week) {
  epiweek_date <- ifelse(year == 2020 & week == 53,
                         "2020-W53",
                         ifelse(year == 2020, ISOweek(ymd(
                           as.Date(paste(year, week, 1, sep = "-"), "%Y-%U-%u")
                         ) - weeks(1)),
                         ISOweek(as.Date(
                           paste(year, week, 1, sep = "-"), "%Y-%U-%u"
                         ))))
  return(epiweek_date)
}
datos_eti <- datos_eti %>% ungroup() %>%
  mutate(semana = 
           yearweek(convert_epiweek(año, semanas_epidemiologicas)))
datos_eti$semana2 <- as.Date(datos_eti$semana)
datos_eti$semana3 <- as.POSIXct(datos_eti$semana)
DT::datatable(head(datos_eti))

Ahora utilizo el paquete Highcharter para hacer una visualización de la serie completa donde pueda agregar y quitar las provincias y ademas filtrar por el eje x, del tiempo para hacer zoom.

Para ello, primero creo la tabla ts_base.

ts_base = datos_eti %>%
  group_by(provincia_nombre, semana) %>% 
  summarise(conteo = sum(conteo))
## `summarise()` has grouped output by 'provincia_nombre'. You can override using
## the `.groups` argument.
ts_base$semana = as.character(ts_base$semana)
DT::datatable(ts_base)

Como se puede observar en la tabla de arriba, hay faltantes en la serie de tiempo. Para algunas provincias hay semanas que estan ausentes porque no hay datos. Para poder contruir gráficos con la libreria Highcharter es necesario tener la serie completa. Una forma fácil de rellenar es utilizando la fn expand_grid().

Esta función crea un nuevo dataframe con todas las combinaciones de dos o mas vectores proporcionados. Una vez generado el grid se realiza un join por derecha para traer los datos de casos notificados.

grid = list(
  provincia_nombre = unique(ts_base$provincia_nombre),
  semana = unique(as.character(ts_base$semana))
)

grid = expand.grid(grid)
data_grafico = left_join(grid, ts_base %>% as.data.frame)
## Joining with `by = join_by(provincia_nombre, semana)`
data_grafico$conteo[is.na(data_grafico$conteo)] = 0
DT::datatable(grid)

Usando la tabla data_grafico se puede elaborarar el gráfico.

grafico =
  highchart() %>%
  hc_chart(type = "line",
           zoomType = 'xy') %>% #aca defino el tipo de grafico y si quiero la funcion para hacer zoom a algun eje
  hc_title(text = "Notificaciones de ETI por SEPI") %>% #titulo
  hc_xAxis(categories = unique(ts_base$semana))%>% ## ejes
  hc_yAxis(title = list(text = "Notificaciones")) #titulos de ejes

provincias_seleccionadas = c("Buenos Aires", "Córdoba", "CABA", "Santa Fe", "Mendoza")

#aca se hace un loop donde se itera por las provincias seleccionadas usando la fn de hc_add_series del paquete highcharter.

for (i in provincias_seleccionadas) {
  conteo = data_grafico$conteo[data_grafico$provincia_nombre == i]
  grafico = grafico %>% hc_add_series(name = i, data = conteo)
}

grafico

Graficos combinados

Se presenta a continuación un gráfico interactivo combinado utilizando highcharter. Se muestras graficos de barra para las semanas epis y un gráfico de torta para mostrar como se distribuye la edad en ese conjunto de datos.

EN primer lugar, preparo tablas para cada uno de estos graficos con los datos por semana y por grupo de edad.

#armo tabla de porcentajes para grafico de torta
torta <- datos_respiratorias %>%
  filter(año == 2022) %>%
  group_by(grupo_edad_desc) %>%
  summarise(casos = sum(cantidad_casos)) %>%
  mutate(porcent = round(casos / sum(casos) * 100, 1))

#ordeno las categorias de grupos de edad para que esten de menor a mayor
torta <- torta %>%
  mutate(
    grupo_edad_desc = case_when(
      grupo_edad_desc == "< 6 m" ~ "1. < 6 m",
      grupo_edad_desc == "6 a 11 m" ~ "2. 6 a 11 m",
      grupo_edad_desc == "10 a 14" ~ "6. 10 a 14",
      grupo_edad_desc == "12 a 23 m" ~ "3. 12 a 23 m",
      grupo_edad_desc == "15 a 19" ~ "7. 15 a 19",
      grupo_edad_desc == "2 a 4" ~ "4. 2 a 4",
      grupo_edad_desc == "20 a 24" ~ "8. 20 a 24",
      grupo_edad_desc == "25 a 34" ~ "9. 25 a 34",
      grupo_edad_desc == "35 a 44" ~ "10. 35 a 44",
      grupo_edad_desc == "45 a 64" ~ "11. 45 a 64",
      grupo_edad_desc == "5 a 9" ~ "5. 5 a 9",
      grupo_edad_desc == "65 a 74" ~ "12. 65 a 74",
      grupo_edad_desc == ">= a 75" ~ "13. >= a 75",
      grupo_edad_desc == "Edad Sin Esp." ~ "14. Edad Sin Esp.",
      TRUE ~ grupo_edad_desc
    )
  ) %>%
  arrange(as.numeric(substring(grupo_edad_desc, 1, 2)))

# armo tabla de n para el gráfico de barras
barras <- datos_respiratorias %>%
  filter(año == 2022) %>%
  group_by(semanas_epidemiologicas) %>%
  summarise(casos = sum(cantidad_casos)) %>%
  mutate(porcent = round(casos / sum(casos) * 100, 1))

# asi quedaro ambas tablas
DT::datatable(torta)
DT::datatable(head(barras))

Código para el gráfico:

highchart() %>%
  hc_add_series(# agrego serie para barras
    barras,
    "column", hcaes(
      x = semanas_epidemiologicas, y = casos
    ),
    name = "Casos de ETI"
  ) %>%
  hc_add_series(#Agrego serie para torta
    torta, "pie", hcaes(
      name = grupo_edad_desc, y = porcent
    ),
    name = "Casos de ETI (%)"
  ) %>%
  ## en ociones puedo definir como quiero ver los labels,y la ubicacion y tamaño
  hc_plotOptions(
    series = list(
      showInLegend = FALSE,
      pointFormat = "{point.y}%",
      colorByPoint = FALSE
    ), 
    pie = list(## caracteristicas del pies
      center = c("65%", "10%"),
      size = 120,
      dataLabels = list(enabled = FALSE),
      colorByPoint = TRUE
    ),
    column = list(groupPadding = 0,#características de las barras
                  pointPadding = 0,
                  borderWidth = 0.3,
                  borderColor = "white",# color de los bordes
                  color= "#377eb8" #color de la barrra
                  )
  )%>%
  ## Axis
  hc_yAxis(
    title = list(text = "Número de casos"),
    labels = list(format = "{value}"),
    max = 50500
  ) %>%
  hc_xAxis(title = list(text = "Semana EPI"),
      categories = barras$semanas_epidemiologicas
  ) %>%
  ## Titles, subtitle, caption and credits
  hc_title(
    text = "Grafico de barras combinado con piechart: Notificaciones de ETI, año 2022"
  ) %>%
  hc_subtitle(
    text = "Ejemplo de grafico combinado para notificaciones de eti por semana y grupo de edad"
  ) %>%
  hc_caption(
    text = "Se representatan casos notificados de ETI al SNVS 2.0"
  ) %>%
  hc_credits(
    enabled = TRUE, text = "Fuente: Datos abiertos/ SNVS", href = "http://datos.salud.gob.ar/", style = list(fontSize = "12px")
  )

Mapas

Se van a presentar mapas de tasa de notificación de Sífilis en ambos sexos, para los años 2018 y 2020.

Leo los datos de datos abiertos que los tengo previamente descargados en una carpeta:

sifilis <-  read.csv("RMD/RMD003_Analisis/datos/tasa-sifilis-por-100-mil-habitantes-sexo-jurisdiccion-2018-2020-argentina_1.csv", encoding = "latin1")
tasas <- sifilis %>% 
  filter(anio==2018|anio==2020, id_sexo==3,
         id_jurisdiccion!=200) %>% 
  spread(anio, jurisdiccion_tasa_sifilis)

DT::datatable(head(tasas))

Leo mapa de argentina en formato RDS:

mapa_arg <- readRDS(url("https://biogeo.ucdavis.edu/data/gadm3.6/Rsf/gadm36_ARG_1_sf.rds"))

mapa_arg <- sf::st_transform(mapa_arg, 5345)## EPSG:5345  posgar 2007/ Argentina faja 3
ggplot(data = mapa_arg) +
    geom_sf(crs=5345)

Unimos tabla de tasas con mapa.

tasas$jurisdiccion <- car::recode(tasas$jurisdiccion,"'CABA'='Ciudad de Buenos Aires'")
table(mapa_arg$NAME_1)
## 
##           Buenos Aires              Catamarca                  Chaco 
##                      1                      1                      1 
##                 Chubut Ciudad de Buenos Aires                Córdoba 
##                      1                      1                      1 
##             Corrientes             Entre Ríos                Formosa 
##                      1                      1                      1 
##                  Jujuy               La Pampa               La Rioja 
##                      1                      1                      1 
##                Mendoza               Misiones                Neuquén 
##                      1                      1                      1 
##              Río Negro                  Salta               San Juan 
##                      1                      1                      1 
##               San Luis             Santa Cruz               Santa Fe 
##                      1                      1                      1 
##    Santiago del Estero       Tierra del Fuego                Tucumán 
##                      1                      1                      1
mapa_arg <- dplyr::left_join(mapa_arg, tasas, by = c("NAME_1"="jurisdiccion"))
tmap_mode("view")
tm_shape(mapa_arg) +
    tm_polygons(c("2018", "2020"), n=4, style="jenks") +
    tm_facets(sync = TRUE, ncol = 2)